Chip 1997 January/CHIP Turkiye Ocak 1997.iso/program/sound/amod30/adnmod.pas

Pascal/Delphi Source File | 1995-08-12 | 46KB | 1,975 lines

{$m 6000,58000,58000}
uses crt,dos,modunit,modtypes,memunit,list,txt3d;
const
_c1 = 1;
_Db1 = 2;
_D1 = 3;
_Eb1 = 4;
_E1 = 5;
_F1 = 6;
_Gb1 = 7;
_G1 = 8;
_Ab1 = 9;
_A1 = 10;
_Bb1 = 11;
_B1 = 12;

_c2 = 1+12;
_Db2 = 2+12;
_D2 = 3+12;
_Eb2 = 4+12;
_E2 = 5+12;
_F2 = 6+12;
_Gb2 = 7+12;
_G2 = 8+12;
_Ab2 = 9+12;
_A2 = 10+12;
_Bb2 = 11+12;
_B2 = 12+12;

_c3 = 1+24;
_Db3 = 2+24;
_D3 = 3+24;
_Eb3 = 4+24;
_E3 = 5+24;
_F3 = 6+24;
_Gb3 = 7+24;
_G3 = 8+24;
_Ab3 = 9+24;
_A3 = 10+24;
_Bb3 = 11+24;
_B3 = 12+24;

col_backr = 0;
col_backg = 0;
col_backb = 10;
col_back = 2;
col_flash = 20;
flash_val : integer= 0;
strobo_speed : integer = 8;

per_txt : array[0..48] of string[3] = ('   ',
          'C-1','C#1','D-1','D#1','E-1','F-1',
          'F#1','G-1','G#1','A-1','A#1','B-1',
          'C-2','C#2','D-2','D#2','E-2','F-2',
          'F#2','G-2','G#2','A-2','A#2','B-2',
          'C-3','C#3','D-3','D#3','E-3','F-3',
          'F#3','G-3','G#3','A-3','A#3','B-3',
          'C-4','C#4','D-4','D#4','E-4','F-4',
          'F#4','G-4','G#4','A-4','A#4','B-4');
hex_tbl : array[0..15] of char = ('0','1','2','3','4','5','6','7',
                                  '8','9','A','B','C','D','E','F');
fx_txt : array[0..15] of string[3] = (        {downcase means fx not}
         'ARP','PR^','PRv','TON','vib','T&S', {correctly supported}
         'V&S','trm','---','SO=','VLs','JMP',
         'VL=','BRK','EFX','SPD');

efx_txt : array[0..15] of string[4] = (
         'filt','FPR^','FPRv','glis','vibf',
         'FTUN','loop','trmf','PAN=','TRIG',
         'FVL^','FVLv','NCUT','NDEL','pdel',
         'funk');

savertime : integer = 18*60*5;

defpan : array[0..11] of integer = (3,12,12,3,3,12,12,3,3,12,12,3);
pan_sign : array[0..11] of integer = (-1,1,1,-1,-1,1,1,-1,-1,1,1,-1);
pan_mode : boolean = false;
pan_speed : integer = 16;
pan_cnt : integer = 16*4;
pan_inc : integer = 1;
qualitymode : boolean = false;

  temp_path : string = 'c:\';
  unzip_opt = ' -o';

{$i adnpic1.inc}
{$i adnpic2.inc}
{$i adnpic3.inc}
{$i adnpic4.inc}
{$i adnpic5.inc}
{$i adnpic6.inc}

var
  gusmem : longint;
  start_sample,cur_sample,play_sample : integer;
  cur_octave : integer;
  old_row : integer;
  mod_name : string;
  pause : byte;
  oldint8,oldint9 : procedure;
  alt_tab : boolean;
  strobo_sam : array[0..31] of boolean;
  strobo_val : integer;
  strobo_col : array[1..3] of integer;
  strobo_fx : boolean;
  help : boolean;
  {golmap1,golmap2 : array[0..51,0..81] of byte;}
  golmap1 : array[0..51,0..81] of byte absolute $b800:8000;
  golmap2 : array[0..51,0..81] of byte absolute $b800:13000;
  normpal,pal : array[0..63,0..2] of byte;
  normkbf : byte;
  int_cnt : integer;
  start_chn : integer;

  lpic : pointer;
  listpic : ^t_memarray;
  flist : t_list;
  strlist : array[0..maxline+1] of string[20];
  typelist : array[0..maxline+1] of integer;
  org_path,old_path,cur_path : string;
  drives : array[1..28] of boolean;
  new_mod,archive : boolean;
  oldpertbl : array[0..15,1..48] of word;

procedure hide_cursor; assembler;
asm
  mov  ax,0100h
  mov  cx,2607h
  int  10h
end;

procedure wait_vr; assembler;
asm
  mov  dx,3dah
@@1:
  in   al,dx
  test al,8
  jz   @@1
end;

procedure wait_novr; assembler;
asm
  mov  dx,3dah
@@1:
  in   al,dx
  test al,8
  jnz  @@1
end;

procedure setvgapal(pal,col1,col2,col3 : byte); assembler;
asm
  cli
  mov  dx,3c8h
  mov  al,pal
  out  dx,al
  inc  dx
  mov  al,col1
  out  dx,al
  mov  al,col2
  out  dx,al
  mov  al,col3
  out  dx,al
  sti
end;

procedure set_scr_ofs(ofs : word); assembler;
asm
  cli
  mov  bx,ofs
  mov  dx,$3d4
  mov  al,0Ch       {Start address high}
  out  dx,al
  inc  dx
  mov  al,bh
  out  dx,al
  dec  dx
  mov  al,0Dh      {Start address high}
  out  dx,al
  inc  dx
  mov  al,bl
  out  dx,al
  sti
end;

procedure line_comp(lc : word);
var
b : byte;
begin
  port[$3d4] := 7;
  if lc and 256 > 0 then b := 31
  else b := 15;
  port[$3d5] := b;
  port[$3d4] := 9;
  port[$3d5] := 7;
  port[$3d4] := $18;
  port[$3d5] := lo(lc);
end;

procedure getpal(p : pointer); assembler;
asm
  cld
  cli
  mov  es,word ptr p+2
  mov  di,word ptr p
  xor  ax,ax
  mov  dx,3c7h
  out  dx,al
  mov  dx,3c9h
  mov  cx,64*3
@@1:
  in   al,dx
  stosb
  loop @@1
  sti
end;

procedure setpal(p : pointer); assembler;
asm
  cld
  cli
  push ds
  mov  ds,word ptr p+2
  mov  si,word ptr p
  xor  ax,ax
  mov  dx,3c8h
  out  dx,al
  inc  dx
  mov  cx,64*3
@@1:
  lodsb
  out  dx,al
  loop @@1
  pop  ds
  sti
end;

function fixgetmem(p : pointer) : pointer;
var
hi,lo : word;
p2 : pointer;
begin
  asm
    mov  ax,word ptr p
    mov  lo,ax
    mov  ax,word ptr p+2
    mov  hi,ax
  end;
  if lo <> 0 then hi := hi+(lo+15) div 16;
  asm
    mov  ax,0
    mov  word ptr p2,ax
    mov  ax,hi
    mov  word ptr p2+2,ax
  end;
  fixgetmem := p2;
end;
{$s-}

function peekkey : char;
var
c : char;
begin
  c := #0;
asm
  mov  ah,1
  int  16h
  jnz   @@end
  mov  ax,0
@@end:
  mov  c,al
end;
  peekkey := c;
end;

procedure fillattr(x,y,xl : integer; attr : byte); assembler;
asm
  mov  ax,0b800h
  mov  es,ax
  mov  di,y
  dec  di
  mov  ax,160
  mul  di
  dec  x
  add  ax,x
  add  ax,x
  mov  di,ax
  inc  di
  mov  cx,xl
  mov  al,attr
@@1:
  mov  es:[di],al
  add  di,2
  loop @@1
end;

procedure fastwrite(x,y : word;s : string);
begin
{l := byte(s[0]);
if l = 0 then exit;
for n := 1 to l do mem[$b800:(y-1)*160+(x-1)*2+n*2-2] := byte(s[n]);}
asm
    push ds
    mov  ax,ss
    mov  ds,ax
    mov  ax,0b800h
    mov  es,ax
    lea  si,s
    lodsb
    cmp  al,0
    jne  @@2
    jmp  @@end
@@2:
    mov  cl,al
    xor  ch,ch
    mov  di,y
    dec  di
    dec  x
    mov  ax,160
    mul  di
    mov  di,ax
    add  di,x
    add  di,x
@@1:
    movsb
    inc  di
    loop @@1
    pop  ds
@@end:
end;
end;

procedure fastwritel(x,y,l : word;s : string);
begin
asm
    push ds
    mov  ax,ss
    mov  ds,ax
    mov  ax,0b800h
    mov  es,ax
    lea  si,s
    inc  si
    mov  cx,l
    cmp  cx,0
    jne  @@2
    ret
@@2:
    mov  di,y
    dec  di
    dec  x
    mov  ax,160
    mul  di
    mov  di,ax
    add  di,x
    add  di,x
@@1:
    movsb
    inc  di
    loop @@1
    pop  ds
end;
end;

procedure scroll_up(y1,yl : word); assembler;
asm
  mov  ax,y1
  mov  cx,160
  mul  cx
  mov  y1,ax
  push ds
  mov  ax,0b800h
  mov  ds,ax
  mov  es,ax
  mov  si,y1
  add  si,160
  mov  di,y1
  mov  bx,yl
@@1:
  mov  cx,80
  rep  movsw
  dec  bx
  jnz  @@1
  pop  ds
end;

function byte2hex(b : byte) : string;
begin
  byte2hex := hex_tbl[b shr 4]+hex_tbl[b and 15];
end;

function nibb2hex(b : byte) : char;
begin
  nibb2hex := hex_tbl[b and 15];
end;

function int2str(i,n : integer) : string;
var
s : string;
begin
  str(i:n,s);
  int2str := s;
end;

function word2str(i,n : word) : string;
var
s : string;
begin
  str(i:n,s);
  word2str := s;
end;

procedure showbyte(x,y : integer;b : byte); assembler;
asm
  dec  y
  dec  x
  mov  ax,0b800h
  mov  es,ax
  mov  di,y
  mov  ax,160
  mul  di
  mov  di,ax
  add  di,x
  add  di,x
  mov  ah,0
  mov  al,b
  mov  cl,10
  div  cl
  add  ax,3030h
  mov  es:[di],al
  add  di,2
  mov  es:[di],ah
end;

procedure showint3(x,y : integer;w : word); assembler;
asm
  dec  y
  dec  x
  mov  ax,0b800h
  mov  es,ax
  mov  di,y
  mov  ax,160
  mul  di
  mov  di,ax
  add  di,x
  add  di,x
  mov  ax,w
  mov  cl,100
  div  cl
  mov  bx,ax
  add  al,30h
  mov  es:[di],al
  add  di,2
  mov  al,bh
  mov  ah,0
  mov  cl,10
  div  cl
  add  ax,3030h
  mov  es:[di],al
  add  di,2
  mov  es:[di],ah
end;

procedure showhex(x,y : integer;b : byte);
begin
  mem[$b800:(y-1)*160+2*x-2] := byte(hex_tbl[b shr 4]);
  mem[$b800:(y-1)*160+2*x] := byte(hex_tbl[b and 15]);
end;

{$s+}
procedure show_pic(ofs,dest : word;pic : pointer); assembler;
asm
  mov  ax,dest
  mov  es,ax
  mov  dx,0
  mov  ax,700h
  mov  cx,0
  mov  di,ofs
  push ds
  mov  si,word ptr pic
  mov  ds,word ptr pic+2
@@start:
  lodsb
  cmp  al,8
  jae  @@char
  cmp  al,0
  je   @@end
  cmp  al,1
  je   @@attr
  cmp  al,2
  je   @@pack
  cmp  al,3
  je   @@space
  jmp  @@start
@@attr:
  lodsb
  mov  ah,al
  jmp  @@start
@@space:
  lodsb
  mov  cl,al
  mov  al,32
  rep  stosw
  jmp  @@start
@@pack:
  lodsb
  mov  cl,al
  lodsb
  rep  stosw
  jmp  @@start
@@char:
  stosw
  jmp  @@start
@@end:
  pop  ds
end;

procedure normscr;
var
n : integer;
begin
  hide_cursor;
  setvgapal(col_back,col_backr,col_backg,col_backb);
  show_pic(8000+0,$b800,@image1);
  show_pic((50+5+header.chns)*160,$b800,@image2);
  show_pic(160,$b800,@image3);
  for n := 0 to header.chns do move(image4,mem[$b800:(4+n)*160+8000],160);
  line_comp((header.chns+9)*8);
  set_scr_ofs(4000);
  if qualitymode then begin
    fastwrite(8,51,'QUALITY MODE');
    fastwrite(62,51,'QUALITY MODE');
  end;
end;

function per2note(per : word) : string;
var
n,n2 : integer;
s : string[3];
begin
  n2 := 0;
  for n := 1 to 48 do begin
    if oldpertbl[0,n] = per then begin
      n2 := n;
      n := 48;
    end;
  end;
  if n2 = 0 then if per = 0 then per2note := '...'
  else per2note := '???'
  else per2note := per_txt[n2];
end;

procedure makepertbl;
var
n,i : integer;
begin
  if not qualitymode then move(oldpertbl,per_table,sizeof(per_table))
  else for n := 0 to 15 do for i := 1 to 48 do begin
    per_table[n,i] := round(per_table[n,i]*(0.975+random(10)/200));
  end;
end;

{$s-}
procedure bar(x,y,l : integer;c : char); assembler;
asm
  cld
  mov  ax,0b800h
  mov  es,ax

  mov  di,y
  dec  di
  mov  ax,160
  mul  di
  dec  x
  add  ax,x
  add  ax,x
  mov  di,ax
  cmp  l,0
  jz   @@3
  mov  cx,l
  mov  al,c
@@1:
  stosb
  inc  di
  dec  cx
  jnz  @@1
@@3:
  mov  cx,17
  sub  cx,l
  mov  al,32
@@2:
  stosb
  inc  di
  dec  cx
  jnz  @@2
end;

{$s+}
procedure show_sample(sam,x,y : integer);
begin
  fillattr(x,y,3,1);
  fastwrite(x,y,int2str(sam,2));
  if strobo_sam[sam] then fillattr(x,y,28,6)
  else fillattr(x+6,y,22,7);
  if sam = cur_sample then fillattr(x,y,3,15);
  fastwritel(x+6,y,22,samples[sam].name);
  fastwrite(x+31,y,word2str(samples[sam].length,5));
  fastwrite(x+39,y,word2str(samples[sam].loopstart,5));
  fastwrite(x+47,y,word2str(samples[sam].loopend,5));
  if samples[sam].ftune > 7 then
    fastwrite(x+55,y,int2str(samples[sam].ftune or $fff0,2))
  else fastwrite(x+55,y,int2str(samples[sam].ftune,2));
  fastwrite(x+61,y,int2str(samples[sam].volume,2));
end;

const
ycol : array[0..73] of byte =
(1,1,
9,9,
11,11,
15,15,
11,11,
9,9,
1,1,
9,9,
11,11,
15,15,
11,11,
9,9,
1,1,
9,9,
11,11,
15,15,
11,11,
9,9,
1,1,
9,9,
11,11,
15,15,
11,11,
9,9,
1,1,
9,9,
11,11,
15,15,
11,11,
9,9,
1,1,
9,9,
11,11,
15,15,
11,11,
9,9,
1,1);

const
scroll_txt : string = 'Welcome to ADNMOD 0.30, the special ASSEMBLY ''95 edition.    '+
                      'Notice that this screen saver, like the rest of ADNMOD, '+
                      'runs in textmode... It makes 3d pretty cool, huh?    ';
var
scroll_msg : array[0..1000] of char;
scroll_len : integer;

procedure scrsaver;
var
n,count : integer;

procedure showgol(yc : integer); assembler;
asm
  push ds
  mov  ax,0b800h
  mov  es,ax
  mov  ds,ax
  mov  di,1
  mov  si,offset golmap1+82+2
  mov  dx,49
@@2:
  mov  cx,80
  pop  ds
  mov  bx,dx
  add  bx,yc
  mov  ah,[bx+offset ycol]

  push ds
  mov  bx,es
  mov  ds,bx
@@1:
  mov  al,ds:[si]
  inc  si
  shl  al,5
  add  al,ah
  mov  es:[di],al
  add  di,2
  dec  cx
  jnz  @@1
  add  si,2
  dec  dx
  jnz  @@2
  pop  ds
end;

procedure muunnagol;
begin
  asm
     push ds
     mov  ax,0b800h
     mov  ds,ax
     mov  es,ax
     mov  di,offset golmap2+82+1
     mov  si,offset golmap1+82+1
     mov  dx,49
@@yloop:

     mov  cx,81-1
     mov  bx,81
     inc  si
     inc  di
@@xloop:
     mov  al,[si-81-2]
     add  al,[si-81-1]
     add  al,[si-81]
     add  al,[si-1]
     add  al,[si+1]
     add  al,[si+81]
     add  al,[si+81+1]
     add  al,[si+81+2]
     mov  ah,[si]
     cmp  al,3
     je   @@live
     cmp  ah,0
     je   @@die_scum
     cmp  al,2
     je   @@live
@@die_scum:
     xor  al,al
     stosb
     jmp  @@loop_end
@@live:
     mov  al,1
     stosb
@@loop_end:
     inc  si
     loop @@xloop
     inc  si
     inc  di

     dec  dx
     jnz  @@yloop
@@end:
     pop  ds
end;
  move(golmap2,golmap1,sizeof(golmap1));
end;

procedure plot(x,y : integer);
var
_x,_y : integer;
begin
  for _y := -2 to 2 do for _x := -2 to 2 do
    golmap1[y+_y,x+_x] := random(2);
end;

procedure initgol;
var
n : integer;
begin
  fillchar(golmap1,sizeof(golmap1),0);
  fillchar(golmap2,sizeof(golmap2),0);
  for n := 1 to 20 do plot(random(70)+5,random(40)+5);
end;

procedure fadeout;
var
n,i : integer;
begin
  for n := 30 downto 0 do begin
    wait_vr;
    for i := 0 to 63 do
      setvgapal(i,pal[i,0]*n div 30,pal[i,1]*n div 30,pal[i,2]*n div 30);
  end;
end;

procedure fadein;
var
n,i : integer;
begin
  for n := 0 to 30 do begin
    wait_vr;
    for i := 0 to 63 do
      setvgapal(i,pal[i,0]*n div 30,pal[i,1]*n div 30,pal[i,2]*n div 30);
  end;
end;

procedure scroll(sc : integer);
var
n : integer;
begin
  for n := 0 to 79 do memw[$b800:49*160+n*2] := 15*256+byte(scroll_msg[sc+n]);
end;

type
ta = array[0..50000] of byte;
pa = ^ta;

var
yc : integer;
pspeed,i : integer;
obj_kx,obj_ky,obj_kz : integer;
buf,p : pointer;
sc,sc2 : integer;

begin
  scroll_len := byte(scroll_txt[0])+102;
  fillchar(scroll_msg,sizeof(scroll_msg),0);
  move(scroll_txt[1],scroll_msg[82],scroll_len-102);
  getmem(p,16000+16);
  buf := ptr(seg(p^)+1,0);
  fillchar(buf^,16000,0);
  txt3d.scr_seg := seg(buf^);
  obj_kx := 0;
  obj_ky := 0;
  obj_kz := 0;
  pan_cnt := pan_cnt*5 div 7;
  pspeed := (pan_speed*5) div 7;
  if pspeed < 1 then pspeed := 1;
  getpal(@pal);
  fadeout;
  fillchar(mem[$b800:0],160*100,0);
  textmode(font8x8+co80);
  setfont;
  hide_cursor;
  init3d;
  l3d_asm95;
  initgol;
  count := 0;
  yc := 0;
  matriisi(matrix,0,0,0);
  rotatep;
  time_counter := 0;
  time_counter2 := 0;
  time_counter3 := 0;
  sc := 0;
  sc2 := 0;
  repeat
    wait_vr;
    mix;
    if time_counter > 0 then begin
      inc(yc);
      if yc > 10 then yc := 0;
      showgol(yc);
      muunnagol;
      inc(sc2);
      if sc2 > scroll_len*2 then sc2 := 0;
      sc := sc2 div 2;
      dec(time_counter);
      inc(count);
      if count mod (6*30) = 0 then case random(4) of
        0 : l3d_cube;
        1 : l3d_pyramid;
        2 : l3d_adnmod;
        3 : l3d_asm95;
      end;
      if count > 18*20 then begin
        time_counter := 0;
        count := 0;
        initgol;
      end;
    end;
    scroll(sc);
    hide;
    matriisi(matrix,obj_kx,obj_ky,obj_kz);
    rotatep;
    show;
    inc(obj_kx,time_counter3 div 6);
    inc(obj_ky,time_counter3 div 6);
    inc(obj_kz,time_counter3 div 6);
    time_counter3 := 0;
    if obj_kx > 1000 then dec(obj_kx,1000);
    if obj_ky > 1000 then dec(obj_ky,1000);
    if obj_kz > 1000 then dec(obj_kz,1000);
    if pan_mode and (time_counter2 > 0) then begin
      inc(pan_cnt,pan_inc*time_counter2);
      if (pan_cnt<=-pspeed*7-pspeed+1) or
      (pan_cnt>=pspeed*7+pspeed-1) then pan_inc := -pan_inc;
      if pan_cnt < -pspeed*7-pspeed+1 then pan_cnt := -pspeed*7;
      if pan_cnt > pspeed*7+pspeed-1 then pan_cnt := pspeed*8;
      for n := 0 to header.chns-1 do begin
        i := (pan_sign[i]*pan_cnt) div pspeed;
        if i > 0 then
          channels[n].pan := 8+i
        else channels[n].pan := 7+i;
        gussetbalance(n,channels[n].pan);
      end;
      time_counter2 := 0;
    end;
  until keypressed;
  readkey;
  freemem(p,16000+16);
  for n := 0 to 63 do setvgapal(n,0,0,0);
  fillchar(mem[$b800:0],80*100*2,0);
  textmode(co80+font8x8);
  for n := 0 to 63 do setvgapal(n,0,0,0);
  fillchar(mem[$b800:0],80*100*2,0);
  normscr;
  for n := 0 to 24-header.chns do show_sample(n+start_sample,9,n+17);
  old_row := 666;
  fadein;
end;

procedure show_chn(chn,st : byte);
var
fx,fxdata : byte;
start : integer;
n : integer;
begin
  start := 5-st+50;
  inc(chn,st);
  fx := channels[chn].fx;
  fxdata := channels[chn].fxdata;
  if channels[chn].on = 1 then
    fastwritel(3,chn+start,22,samples[channels[chn].sample].name)
  else fastwritel(3,chn+start,22,'     ---MUTED---        ');
  fastwrite(30,chn+start,int2str(channels[chn].vol,2));
  fastwritel(34,chn+start,3,per_txt[channels[chn].note]);
  fastwrite(38,chn+start,int2str(channels[chn].per,3));
  fastwrite(43,chn+start,int2str(channels[chn].dper,3));
  fastwrite(54,chn+start,int2str(shortint(channels[chn].pan)-7,2));
  if fx = 14 then
    fastwritel(47,chn+start,5,efx_txt[fxdata shr 4]+nibb2hex(fxdata and 15))
  else if ((fx < 16) and (fx >0)) or ((fx = 0) and (fxdata > 0)) then
    fastwritel(47,chn+start,5,fx_txt[fx]+byte2hex(fxdata))
  else fastwritel(47,chn+start,5,'     ');
  bar(61,chn+start,(channels[chn].bar+2) div 4,'≈');
  if channels[chn].hit <> 0 then begin
    fillattr(3,chn+start,22,15);
    fillattr(30,chn+start,26,15);
    channels[chn].hit := 2;
  end else begin
    fillattr(3,chn+start,22,7);
    fillattr(30,chn+start,26,7);
  end;
end;

procedure show_row(ptn,row : integer);
const
wid = 16;
x = 11;
var
  n : integer;
  sam : integer;
  fx,fxdata : byte;
  chn : integer;
  st : integer;
  _ptn : p_pattern;
begin
  _ptn := virt_getptn(ptn);
  st := 13;
  fastwrite(8,st,byte2hex(row)+':');
  for n := 0 to 3 do begin
    chn := start_chn+n;
    fastwrite(n*wid+x+2,st,
      per2note(_ptn^[row*header.chns+chn].per)+' ');
    sam := _ptn^[row*header.chns+chn].sample;
    if sam > 0 then fastwrite(n*wid+x+6,st,byte2hex(sam)+' ')
    else fastwrite(n*wid+x+6,st,'.. ');
    fx := _ptn^[row*header.chns+chn].fx;
    fxdata := _ptn^[row*header.chns+chn].fxdata;
    case fx of
      0 : if fxdata > 0 then
            fastwrite(n*wid+x+9,st,fx_txt[fx]+byte2hex(fxdata))
          else fastwrite(n*wid+x+9,st,'     ');
      1..$D : fastwrite(n*wid+x+9,st,fx_txt[fx]+byte2hex(fxdata));
      $E : fastwrite(n*wid+x+9,st,efx_txt[fxdata shr 4]+nibb2hex(fxdata and 15));
      $F : fastwrite(n*wid+x+9,st,fx_txt[fx]+byte2hex(fxdata));
    else fastwrite(n*wid+x+9,st,'     ');
    end;
  end;
end;

procedure show_info(ptn:integer);
var
st : integer;
begin
  st := 50+8 + header.chns;
  fastwrite(30,st,int2str(amp_vol,2));
  fastwrite(41,st,int2str(speed,2));
  if not vblank then fastwrite(53,st,int2str(tempo,3)+'   ')
  else fastwrite(53,st,'VBlank');
  fastwrite(30,st+1,int2str(cur_ptn,2)+'/'+int2str(header.length-1,2));
  fastwrite(41,st+1,int2str(ptn,2)+'/'+int2str(max_ptn-1,2));
  fastwrite(53,st+1,int2str(cur_row,2));
end;

procedure updateinfo;
var
i,n : integer;
kbf : byte;
begin
  if not loaded then exit;
  wait_vr;
  if strobo_fx then for i := 0 to header.chns-1 do
    if (channels[i].hit <> 0) and (channels[i].on <> 0) then
      if strobo_sam[channels[i].sample]=true then strobo_val := 62;
  i := strobo_val and strobo_col[3];
  if i < col_backb then i := col_backb;
  setvgapal(0,strobo_val and strobo_col[1],
              strobo_val and strobo_col[2],
              strobo_val and strobo_col[3]);
  setvgapal(2,strobo_val and strobo_col[1],
              strobo_val and strobo_col[2],
              i);
  if strobo_val > 0 then dec(strobo_val,strobo_speed);
  if strobo_val < 0 then strobo_val := 0;
  dec(flash_val);
  if flash_val<-19 then flash_val := 20;
  n := abs(flash_val)+43;
  setvgapal(col_flash,n,n,n);
  kbf := mem[$40:$17] and 15;
  if channels[start_chn].hit=1 then kbf := kbf or $20;
  if channels[start_chn+1].hit=1 then kbf := kbf or $40;
  if channels[start_chn+2].hit=1 then kbf := kbf or $10;
  mem[$40:$17] := kbf;
  if pan_mode then begin
    inc(pan_cnt,pan_inc);
    if (pan_cnt=-pan_speed*7-pan_speed+1) or
    (pan_cnt=pan_speed*7+pan_speed-1) then pan_inc := -pan_inc;
    for i := 0 to header.chns-1 do begin
      n := (pan_sign[i]*pan_cnt) div pan_speed;
      if n > 0 then
        channels[i].pan := 8+n
      else channels[i].pan := 7+n;
      gussetbalance(i,channels[i].pan);
    end;
  end;
  for i := 0 to header.chns-1 do show_chn(i,0);
  show_info(orders[cur_ptn]);
end;

procedure show_ptn(clear : boolean);
var
  ptn : word;
var
  i,n : integer;
  s : string;
  c : char;
  helpcnt : integer;

begin
  helpcnt := 0;
  strobo_val := 0;
  fastwritel(30,50+7+header.chns,20,header.name);
  for i := 0 to 24-header.chns do show_sample(i+start_sample,9,i+17);
  if clear then begin
    s := '                                                                   ';
    for i := 0 to 7 do fastwritel(8,14+50+header.chns+i,65,s);
  end;
  time_counter := 0;
  repeat
    updateinfo;
    ptn := orders[cur_ptn];
    time_counter2 := 0;
    if (not help) and (cur_row <> old_row) then begin
      old_row := cur_row;
      fillattr(13,13,60,7+2*16);
      scroll_up(4,8);
      show_row(orders[cur_ptn],cur_row);
      fillattr(13,13,60,15+2*16);
    end;
    if upcase(peekkey) = 'H' then begin
      readkey;
      time_counter := 0;
      if help then begin
        show_pic(160,$b800,@image3);
        fastwritel(30,50+7+header.chns,20,header.name);
        for i := 0 to 24-header.chns do show_sample(i+start_sample,9,i+17);
        help := false;
      end
      else begin
        help := true;
        show_pic(160,$b800,@image5);
      end;
    end;
    if time_counter > savertime then begin
      time_counter := 0;
      scrsaver;
    end;
  until keypressed;
  if help then begin
    show_pic(160,$b800,@image3);
    help := false;
  end;
  mem[$40:$17] := mem[$40:$17] and 15;
end;

{$s-,i-}
procedure int9; interrupt;
begin
  if (mem[$40:$17] and 8 > 0) and (port[$60] = $f) then
    if alt_tab then begin
      alt_tab := false;
    end
    else begin
      alt_tab := true;
    end;
  asm pushf end;
  oldint9;
end;

procedure fwritel(x,y,l : integer;s : pointer); assembler;
asm
  push ds
  mov  ax,word ptr s+2
  mov  ds,ax
  mov  ax,0b800h
  mov  es,ax
  mov  si,word ptr s
  inc  si
  mov  cx,l
  cmp  cx,0
  jne  @@2
  ret
@@2:
  mov  di,y
  dec  di
  dec  x
  mov  ax,160
  mul  di
  mov  di,ax
  add  di,x
  add  di,x
@@1:
  movsb
  inc  di
  loop @@1
  pop  ds
end;

procedure int8; interrupt;
var
n,i,pspeed : integer;
p : longint;
fx,fxdata : byte;
st : integer;
begin
  asm pushf end;
  oldint8;
  dec(int_cnt);
  if int_cnt = 0 then begin
   int_cnt := 14;
   if alt_tab then begin
    if pan_mode then begin
      pspeed := pan_speed;
      if pspeed < 1 then pspeed := 1;
      inc(pan_cnt,pan_inc);
      if (pan_cnt<=-pspeed*8+1) or
      (pan_cnt>=pspeed*8-1) then pan_inc := -pan_inc;
      if pan_cnt < -pspeed*8+1 then pan_cnt := -pspeed*7;
      if pan_cnt > pspeed*8-1 then pan_cnt := pspeed*7;
    end;
    st := 50+9+header.chns;
    showbyte(53,st,cur_row);
    showbyte(41,st,speed);
    showbyte(30,st,cur_ptn);
    showbyte(33,st,header.length-1);
    showbyte(41,st,orders[cur_ptn]);
    showbyte(44,st,max_ptn-1);
    for n := 0 to header.chns-1 do begin
      dec(strobo_val,3);
      if strobo_val < 0 then strobo_val := 0;
      if strobo_fx then begin
        port[$3c8] := 0;
        port[$3c9] := strobo_val and strobo_col[1];
        port[$3c9] := strobo_val and strobo_col[2];
        port[$3c9] := strobo_val and strobo_col[3];
      end;
      if pan_mode then begin
        i := integer(pan_sign[n]*pan_cnt) div pspeed;
        if i > 0 then
          channels[n].pan := 8+i
        else channels[n].pan := 7+i;
        gussetbalance(n,channels[n].pan);
      end;
      fx := channels[n].fx;
      fxdata := channels[n].fxdata;
      p := longint(@samples[channels[n].sample].name)-1;
      fwritel(3,n+55,22,pointer(p));
      showbyte(30,n+55,channels[n].vol);
      fwritel(34,n+55,3,@per_txt[channels[n].note]);
      showint3(38,n+55,channels[n].per);
      showint3(43,n+55,channels[n].dper);
      showbyte(54,n+55,channels[n].pan);
      if fx = 14 then begin
        showhex(50,n+55,fxdata and 15);
        fwritel(47,n+55,4,@efx_txt[fxdata shr 4]);
      end
      else if (fx < 16) and (fx >0) then begin
        fwritel(47,n+55,3,@fx_txt[fx]);
        showhex(50,n+55,fxdata);
      end;
      if fx > 15 then fillchar(mem[$b800:(n+54)*160+46*2],10,0);
      bar(61,55+n,(channels[n].bar+2) div 4,'≈');
      if channels[n].hit = 1 then begin
        fillattr(3,n+55,22,15);
        fillattr(30,n+55,26,15);
        if strobo_fx then
          if strobo_sam[channels[n].sample] then strobo_val := 62;
      end else begin
        fillattr(3,n+55,22,7);
        fillattr(30,n+55,26,7);
      end;
    end;
   end;
  end;
end;
{$s+,i+}

procedure init_dos;
var
n : integer;
begin
  gotoxy(1,1);
  alt_tab := true;
  int_cnt := 14;
  getintvec(9,@oldint9);
  getintvec(8,@oldint8);
  asm
    cld
    mov  ax,0B800h
    mov  es,ax
    mov  di,0
    mov  cx,4000
    mov  ax,0720h
    rep  stosw
  end;
  mem[$40:$84] := 40-header.chns;
  set_scr_ofs(4000);
  line_comp((9+header.chns)*8);
  setpal(@normpal);
  setintvec(9,@int9);
  setintvec(8,@int8);
end;

procedure end_dos;
begin
  setintvec(8,@oldint8);
  setintvec(9,@oldint9);
end;

procedure initlist;
var
f : file;
n,i,maxdrive : integer;
s : string;
begin
  getmem(lpic,8000);
  listpic := fixgetmem(lpic);
  s := getenv('TEMP');
  if s <> '' then temp_path := s;
  archive := false;
  textmode(co80+font8x8);
  flist.init(maxline,11,3,68,30,listpic);
  flist.c2x := 21;
  fillchar(listpic^,8000,0);
  show_pic(0,seg(listpic^),@image6);
  getdir(0,org_path);
  getdir(0,cur_path);
  fillchar(drives,sizeof(drives),0);
  drives[1] := true;
  drives[2] := false;
  for n := 3 to 28 do if diskfree(n)>-1 then drives[n] := true;
end;

function getmodname(s : string) : string;
var
f : file;
s2 : string;
begin
  assign(f,s);
  reset(f,1);
  blockread(f,s2[1],20);
  s2[0] := #20;
  close(f);
  getmodname := s2;
end;

procedure load;
var
dirinfo : searchrec;
n : integer;
s : string;
maxstr : integer;

begin
  maxstr := 0;
  findfirst('*.mod',anyfile,dirinfo);
  while (doserror = 0) and (maxstr < maxline) do begin
    strlist[maxstr] := dirinfo.name;
    typelist[maxstr] := t_mod;
    inc(maxstr);
    findnext(dirinfo);
  end;
  if not archive then begin
    findfirst('*.zip',anyfile,dirinfo);
    while (doserror = 0) and (maxstr < maxline) do begin
      strlist[maxstr] := dirinfo.name;
      typelist[maxstr] := t_zip;
      inc(maxstr);
      findnext(dirinfo);
    end;
    findfirst('*.*',$10,dirinfo);
    while (doserror = 0) and (maxstr < maxline) do begin
      if dirinfo.attr and $18 <> 0 then begin
        strlist[maxstr] := dirinfo.name;
        typelist[maxstr] := t_dir;
        inc(maxstr);
      end;
      findnext(dirinfo);
    end;
  end
  else begin
    strlist[maxstr] := '..';
    typelist[maxstr] := t_dir;
    inc(maxstr);
  end;
  dec(maxstr);
  if not archive then for n := 1 to 28 do if drives[n]=true then begin
    inc(maxstr);
    strlist[maxstr] := char(n+64)+':';
    typelist[maxstr] := t_drive;
  end;
  for n := 0 to maxstr do begin
    case typelist[n] of
      t_dir : s := 'DIR';
      t_zip : s := 'ARCHIVE';
      t_mod : s := getmodname(strlist[n]);
      else s := '';
    end;
    flist.insline(strlist[n],s,'',typelist[n]);
  end;
  flist.qsort;
end;

procedure unzip(s : string);
var
zippath : string;
begin
  zippath := fsearch('PKUNZIP.EXE',getenv('PATH'));
  chdir(temp_path);
  exec(zippath,s+' *.mod '+unzip_opt);
  if doserror <> 0 then begin
    writeln('Dos error ',doserror);
    delay(500);
  end;
end;

function countfiles(s : string) : integer;
var
dir : searchrec;
n : integer;
begin
  n := 0;
  findfirst(s,anyfile,dir);
  while doserror = 0 do begin
    inc(n);
    findnext(dir);
  end;
  countfiles := n;
end;

procedure delall;
var
s : searchrec;
f : file;
begin
  findfirst('*.mod',anyfile,s);
  while (doserror = 0) do begin
    assign(f,s.name);
    erase(f);
    findnext(s);
  end;
end;

procedure doit(num : integer);
var
n : integer;
begin
  if not archive then case flist.lines^[num].t of
    t_mod : begin
              clrscr;
              stop_playing;
              free_mod;
              move(oldpertbl,per_table,sizeof(per_table));
              load_mod(flist.lines^[num].s[0],false);
              makepertbl;
              start_playing;
              new_mod := true;
              chdir(cur_path);
              move(listpic^,mem[$b800:0],6400);
              hide_cursor;
              flist.draw;
              hide_cursor;
            end;
    t_dir : begin
              chdir(flist.lines^[num].s[0]);
              getdir(0,cur_path);
              flist.delete;
              load;
              move(listpic^,mem[$b800:0],6400);
              flist.draw;
           end;
    t_drive : begin
                chdir(flist.lines^[num].s[0]);
                getdir(0,cur_path);
                flist.delete;
                load;
                move(listpic^,mem[$b800:0],6400);
                flist.draw;
              end;
    t_zip : begin
              getdir(0,old_path);
              cur_path := temp_path;
              fillchar(mem[$b800:0],6400,0);
              textattr := 0;
              gotoxy(1,1);
              unzip(old_path+'\'+flist.lines^[num].s[0]);
              textattr := 7;
              n := countfiles('*.mod');
              if n = 0 then begin
                fillchar(mem[$b800:0],8000,0);
                move(listpic^,mem[$b800:0],6400);
                hide_cursor;
                chdir(old_path);
                flist.delete;
                load;
                flist.draw;
              end
              else if n = 1 then begin
                archive := false;
                flist.delete;
                load;
                stop_playing;
                free_mod;
                move(oldpertbl,per_table,sizeof(per_table));
                load_mod(flist.lines^[1].s[0],false);
                makepertbl;
                start_playing;
                delall;
                new_mod := true;
                fillchar(mem[$b800:0],8000,0);
                move(listpic^,mem[$b800:0],6400);
                hide_cursor;
                chdir(old_path);
                flist.delete;
              end
              else begin
                archive := true;
                flist.delete;
                load;
                hide_cursor;
                move(listpic^,mem[$b800:0],6400);
                flist.draw;
              end;
            end;
  end
  else begin
    if flist.lines^[num].t = t_mod then begin
      chdir(temp_path);
      stop_playing;
      free_mod;
      move(oldpertbl,per_table,sizeof(per_table));
      load_mod(flist.lines^[num].s[0],false);
      makepertbl;
      start_playing;
      new_mod := true;
      fillchar(mem[$b800:0],8000,0);
      move(listpic^,mem[$b800:0],6400);
      flist.draw;
      hide_cursor;
    end
    else begin
      archive := false;
      chdir(temp_path);
      delall;
      chdir(old_path);
      cur_path := old_path;
      flist.delete;
      load;
      hide_cursor;
      move(listpic^,mem[$b800:0],6400);
      flist.draw;
    end;
  end;
end;

procedure dolist;
var
ch : char;
n : integer;
begin
  move(listpic^,mem[$b800:0],8000);
  flist.delete;
  if archive then chdir(temp_path);
  load;
  flist.draw;
  repeat
    new_mod := false;
    repeat
      updateinfo;
    until keypressed;
    ch := readkey;
    case upcase(ch) of
      'A'..'Z' : begin
                   flist.gotokey(upcase(ch));
                 end;
      #0 : begin
             ch := readkey;
             case ch of
               #72 : flist.upline;
               #80 : flist.downline;
               #73 : flist.uppage;
               #81 : flist.downpage;
               #71 : flist.gohome;
               #79 : flist.goend;
             end;
           end;
      ' ' : flist.tagline;
      #8 : flist.draw;
      #13 : doit(flist.curline);
    end;
  until (ch=#27) or (new_mod);
  if new_mod then begin
    strobo_fx := false;
    for n := 0 to 31 do strobo_sam[n] := false;
    pan_mode := false;
  end;
  fillchar(mem[$b800:0],16000,0);
  normscr;
end;

procedure soita(sam,note : integer);
var
freq,vol,st_ofs : integer;
begin
  gusstopvoice(13);
  gussetbalance(13,7);
  if samples[sam].length < 3 then exit;
  freq := periods[per_table[samples[sam].ftune,note]];
  vol := gusvol[samples[sam].volume]*amp_vol+20000;
  st_ofs := 2;
  if (samples[sam].loopend > 2) then
    gusplayall(13,8,gus_addr[sam]+st_ofs,
                     gus_addr[sam]+samples[sam].loopstart,
                     gus_addr[sam]+samples[sam].loopend,freq,vol)
    else gusplayall(13,0,gus_addr[sam]+st_ofs,
                          gus_addr[sam]+st_ofs,
                          gus_addr[sam]+samples[sam].length,freq,vol);
end;

function key2note(ch : char;okt : integer) : integer;
var
note : integer;
begin
  case ch of
    'Q' : note := _C2+okt;
    'W' : note := _D2+okt;
    'E' : note := _E2+okt;
    'R' : note := _F2+okt;
    'T' : note := _G2+okt;
    'Y' : note := _A2+okt;
    'U' : note := _B2+okt;
    'I' : note := _C3+okt;
    'O' : note := _D3+okt;
    'P' : note := _E3+okt;
    '2' : note := _Db2+okt;
    '3' : note := _Eb2+okt;
    '5' : note := _Gb2+okt;
    '6' : note := _Ab2+okt;
    '7' : note := _Bb2+okt;
    '9' : note := _Db3+okt;
    'Z' : note := _C1+okt;
    'X' : note := _D1+okt;
    'C' : note := _E1+okt;
    'V' : note := _F1+okt;
    'B' : note := _G1+okt;
    'N' : note := _A1+okt;
    'M' : note := _B1+okt;
    'S' : note := _Db1+okt;
    'D' : note := _Eb1+okt;
    'G' : note := _Gb1+okt;
    'H' : note := _Ab1+okt;
    'J' : note := _Bb1+okt;
    else note := 0;
  end;
  if note > 48 then dec(note,12);
  key2note := note;
end;

procedure menu;
var
ch : char;
clr : boolean;
n : integer;
begin
  clr := true;
  start_chn := 0;
  pause := 0;
  old_row := 666;
  start_sample := 1;
  cur_sample := 1;
  play_sample := 0;
  cur_octave := 1;
  help := false;
  hide_cursor;
  getpal(@normpal);
  setvgapal(col_back,col_backr,col_backg,col_backb);
  fillchar(listpic^,8000,0);
  show_pic(0,seg(listpic^),@image6);
  show_pic(8000+0,$b800,@image1);
  show_pic((50+5+header.chns)*160,$b800,@image2);
  if loaded then show_pic(160,$b800,@image3)
  else show_pic(160,$b800,@image6);
  for n := 0 to header.chns do
    move(image4,mem[$b800:(4+n)*160+8000],160);
  line_comp((header.chns+9)*8);
  set_scr_ofs(4000);
  if loaded then start_playing;
  repeat
    if loaded then show_ptn(clr);
    clr := false;
    if loaded then ch := readkey
    else ch := #13;
    if (play_sample <> 0) and (key2note(upcase(ch),cur_octave*12) <> 0) then begin
      soita(play_sample,key2note(upcase(ch),cur_octave*12));
      ch := #1;
    end;
    if (play_sample <> 0) and (key2note(upcase(ch),cur_octave*12)=0) then begin
      if (ch = '+') and (cur_octave<2) then inc(cur_octave);
      if (ch = '-') and (cur_octave>0) then dec(cur_octave);
      if upcase(ch) in ['A'..'Z','+','-'] then ch := #1;
    end;
    case ch of
      '+' : if amp_vol < 16 then begin
              inc(amp_vol);
              for n := 0 to header.chns do
                gussetvolume(n,gusvol[channels[n].vol]*amp_vol+20000);
            end;
      '-' : if amp_vol > 0 then begin
              dec(amp_vol);
              for n := 0 to header.chns do
                gussetvolume(n,gusvol[channels[n].vol]*amp_vol+20000);
            end;
      ',' : if start_chn > 0 then begin
              dec(start_chn);
              clr := true;
            end;
      '.' : if start_chn < header.chns-4 then begin
              inc(start_chn);
              clr := true;
            end;
      'P','p' : if pause = 0 then begin
                  pause := speed;
                  speed := 0;
                  for n := 0 to maxchn-1 do gusstopvoice(n);
                  strobo_val := 0;
                end else begin
                  speed := pause;
                  pause := 0;
                end;
      'R','r' : if playing then begin
                  stop_playing;
                  playing := false;
                end else begin
                  clr := true;
                  start_playing;
                  playing := true;
                end;
      'V','v' : if vblank then vblank := false
                else vblank := true;
      'b','B' : if strobo_sam[cur_sample]=true then strobo_sam[cur_sample]:=false
                else begin
                  strobo_sam[cur_sample] := true;
                  strobo_fx := true;
                end;
      'A','a' : if pan_mode then begin
                  for n := 0 to header.chns-1 do begin
                    channels[n].pan := defpan[n];
                    gussetbalance(n,defpan[n]);
                  end;
                  pan_mode := false;
                  pan_cnt := 4*pan_speed;
                end
                else begin
                  pan_mode := true;
                  pan_cnt := 4*pan_speed;
                  pan_inc := 1;
                end;
      'Q','q' : if qualitymode then begin
                  qualitymode := false;
                  makepertbl;
                  normscr;
                end
                else begin
                  qualitymode := true;
                  makepertbl;
                  normscr;
                end;
      ' ' : if play_sample <> 0 then begin
              gussetvolume(13,0);
              gusstopvoice(13);
              play_sample := 0;
            end
            else play_sample := cur_sample;
      #13 : dolist;
      #8 : begin      {bkspc}
             goto_mod(cur_ptn,0);
             clr := true;
           end;
      #0 : begin
             ch := readkey;
             case ch of
               #81 : if speed < 31 then begin  {pgdn}
                       inc(nspeed);
                       inc(speed);
                     end;
               #73 : if speed > 0 then begin   {pgup}
                       dec(nspeed);
                       dec(speed);
                     end;
               #59..#66 : if byte(ch)-59 < header.chns then begin  {F1-F8}
                            channels[byte(ch)-59].on :=
                              channels[byte(ch)-59].on xor 1;
                            gusstopvoice(byte(ch)-59);
                          end;
               #75 : begin    {left arrow}
                       if cur_ptn > 0 then
                         goto_mod(cur_ptn-1,0)
                       else goto_mod(0,0);
                       clr := true;
                     end;
               #77 : begin    {right arrow}
                       if cur_ptn < header.length-1 then
                         goto_mod(cur_ptn+1,0)
                       else goto_mod(cur_ptn,0);
                       clr := true;
                     end;
               #72 : begin {up}
                       if cur_sample > 1 then dec(cur_sample);
                       if cur_sample < start_sample then dec(start_sample);
                       if play_sample <> 0 then play_sample := cur_sample;
                     end;
               #80 : begin  {down}
                       if cur_sample < 31 then inc(cur_sample);
                       if cur_sample > (start_sample+24-header.chns) then
                         inc(start_sample);
                       if play_sample <> 0 then play_sample := cur_sample;
                     end;
             end;
           end;
      'S','s' : scrsaver;
      '!' : begin
              textmode(co80);
              exec(getenv('COMSPEC'),'');
              textmode(co80+font8x8);
              normscr;
              old_row := 666;
            end;
      '"' : begin
              init_dos;
              exec(getenv('COMSPEC'),'');
              end_dos;
              textmode(co80+font8x8);
              normscr;
              old_row := 666;
            end;
    end;
  until (ch = #27) or (not loaded);
  stop_playing;
end;

function exists(s : string) : boolean;
var
f : file of byte;
i : integer;
begin
  assign(f,s);
  {$i-}
  reset(f);
  i := ioresult;
  {$i+}
  if i = 0 then begin
    close(f);
    exists := true;
  end else exists := false;
end;

function addext(str,ext: string) : string;
begin
  if pos('.',str) > 0 then addext := str
  else addext := str+ext;
end;

function findgus : word;
var
n,c,i : word;
begin
  if getenv('ultrasnd') = '' then begin
    findgus := 0;
    exit;
  end;
  val(copy(getenv('ultrasnd'),1,3),n,c);
  if c <> 0 then begin
    findgus := 0;
    exit;
  end;
  case n of
    210 : i := $210;
    220 : i := $220;
    230 : i := $230;
    240 : i := $240;
    250 : i := $250;
    260 : i := $260;
    270 : i := $270;
  else begin
    findgus := 0;
    exit;
  end;
end;
findgus := i;
end;

procedure getcmd;
var
s : string;
b : byte;
i,n,c : integer;

begin
  mod_name :=  '';
  for n := 0 to 31 do strobo_sam[n] := false;
  strobo_fx := false;
  strobo_col[1] := $ff;
  strobo_col[2] := $ff;
  strobo_col[3] := $ff;
  writeln('Adrenalin module player v 0.30  By: Beta/Adrenalin');
  if paramcount > 0 then for n := 1 to paramcount do begin
    if copy(paramstr(n),1,1) <> '/' then begin
      s := addext(paramstr(n),'.mod');
      if not exists(s) then begin
        writeln('Module ',s,' not found!');
        halt(2);
      end;
      mod_name := s;
    end
    else if copy(paramstr(n),1,5) = '/port' then begin
      s := copy(paramstr(n),6,3);
      if s = '210' then base := $210;
      if s = '220' then base := $220;
      if s = '230' then base := $230;
      if s = '240' then base := $240;
      if s = '250' then base := $250;
      if s = '260' then base := $260;
      if s = '270' then base := $270;
    end
    else if copy(paramstr(n),1,5)='/ssam' then begin
      val(copy(paramstr(n),6,2),i,c);
      if (i > 0) and (i < 32) then begin
        strobo_fx := true;
        strobo_sam[i] := true;
      end;
    end
    else if copy(paramstr(n),1,5)='/scol' then begin
      strobo_col[1] := 0;
      strobo_col[2] := 0;
      strobo_col[3] := 0;
      val(copy(paramstr(n),6,2),i,c);
      if (i > 0) and (i < 8) then begin
        if i and 1 > 0 then strobo_col[3] := $ff;
        if i and 2 > 0 then strobo_col[2] := $ff;
        if i and 4 > 0 then strobo_col[1] := $ff;
      end;
    end
    else if copy(paramstr(n),1,5)='/sspd' then begin
      val(copy(paramstr(n),6,2),i,c);
      if i > 0 then strobo_speed := i;
    end
    else if copy(paramstr(n),1,5)='/pspd' then begin
      val(copy(paramstr(n),6,2),i,c);
      if i > 0 then pan_speed := i;
      pan_cnt := 4*pan_speed;
    end
    else if copy(paramstr(n),1,2)='/?' then begin
      writeln('Usage: ADNMOD modname [options]');
      writeln('options:  /portxxx    set gus address');
      writeln('          /scolx      set strobo color');
      writeln('          /ssamxx     set strobo sample');
      writeln('          /sspdxx     set strobo speed');
      halt(0);
    end;
  end;
end;

procedure initialize;
begin
  if base = $200 then if findgus > 0 then base := findgus;
  gusfind;
  if base = $200 then begin
    writeln('GUS not found. Assuming address 220');
    base := $220;
    gusfind;
  end;
  write('GUS found at ',nibb2hex(hi(base)),byte2hex(lo(base)));
  gusmem := gusfindmem;
  writeln(' with ',gusmem,' bytes of memory');
  gusreset;
  move(per_table,oldpertbl,sizeof(per_table));
  normkbf := mem[$40:$17];
end;

procedure showerr(error : integer);
begin
  case error of
    1 : writeln('Too many channels');
    2 : begin
          writeln;
          writeln('Load error!');
        end;
    3 : begin
          writeln;
          writeln('Out of memory');
        end;
    255 : writeln('Error');
  end;
end;

var
i,n : integer;
per : real;

begin
  randomize;
  checkbreak := false;
  getcmd;
  initialize;
  init_mod;
  if initxms <> 0 then begin
    writeln('XMS not found');
    halt(3);
  end;
  if mod_name <> '' then begin
    load_mod(mod_name,true);
    if mod_error <> 0 then begin
      showerr(mod_error);
      halt(mod_error);
    end;
  end;
  textmode(co80+font8x8);
  initlist;
  menu;
  chdir(temp_path);
  delall;
  chdir(org_path);
  freemem(lpic,8000);
  free_mod;
  if isxms then donexms;
  gusdeinit;
  textmode(co80);
  mem[$40:$17] := 0;
  if mod_error <> 0 then showerr(mod_error);
  if virt_info.err_wptn <> -1 then begin
    writeln('Error in warnptn. Please report error numbers and module name to author');
    writeln('cptn: ',virt_info.err_cptn);
    writeln('wptn: ',virt_info.err_wptn);
    writeln('nptn: ',virt_info.err_nptn);
  end;
  writeln('Thank you for using ADNMOD 0.30');
end.